home *** CD-ROM | disk | FTP | other *** search
/ Varios Español / Varios Español.iso / DBASE5 / SAMPLES.ZIP / PREFIJOS.FRG < prev    next >
Text File  |  1994-10-12  |  6KB  |  247 lines
  1. * Programa...........: C:\DBASE20\EJEMPLOS\PREFIJOS.FRG
  2. * Fecha..............: 2-23-93
  3. * Versión............: dBASE IV, Informes 2.0
  4. *
  5. * Notas:
  6. * ------
  7. * Antes de ejecutar este procedimiento con el mandato DO
  8. * es necesario usar LOCATE, pues la sentencia CONTINUE
  9. * está en el bucle principal.
  10. *
  11. *-- Parámetros
  12. PARAMETERS gl_noeject, gl_plain, gl_summary, gc_heading, gc_extra
  13. ** Los tres primeros parámetros son de tipo lógico
  14. ** El cuarto es una serie y el quinto es un parámetro adicional.
  15. PRIVATE _peject, _wrap
  16.  
  17. *-- Comprueba si no se ha encontrado ningún registro
  18. IF EOF() .OR. .NOT. FOUND()
  19.    RETURN
  20. ENDIF
  21.  
  22. *-- Desactiva la justificación entre márgenes.
  23. _wrap=.F.
  24.  
  25. IF _plength < (_pspacing * 4 + 1) + (_pspacing * 2 + 1) + 2
  26.    SET DEVICE TO SCREEN
  27.    DEFINE WINDOW gw_report FROM 7,17 TO 11,62 DOUBLE
  28.    ACTIVATE WINDOW gw_report
  29.    @ 0,1 SAY "Aumente la longitud de página del informe."
  30.    @ 2,1 SAY "Pulse una tecla ..."
  31.    x=INKEY(0)
  32.    DEACTIVATE WINDOW gw_report
  33.    RELEASE WINDOW gw_report
  34.    RETURN
  35. ENDIF
  36.  
  37. _plineno=0          && pone el número de líneas a cero
  38. *-- Parámetro NOEJECT
  39. IF gl_noeject
  40.    IF _peject="BEFORE"
  41.       _peject="NONE"
  42.    ENDIF
  43.    IF _peject="BOTH"
  44.       _peject="AFTER"
  45.    ENDIF
  46. ENDIF
  47.  
  48. *-- Establecimiento de entorno
  49. ON ESCAPE DO Prnabort
  50. IF SET("TALK")="ON"
  51.    SET TALK OFF
  52.    gc_talk="ON"
  53. ELSE
  54.    gc_talk="OFF"
  55. ENDIF
  56. gc_space=SET("SPACE")
  57. SET SPACE OFF
  58. gc_time=TIME()      && Tiempo del sistema para el campo predefinido
  59. gd_date=DATE()      && Fecha del sistema  "    "    "     "
  60. gl_fandl=.F.        && indicador de primera y última página
  61. gl_prntflg=.T.      && indicador de continuar impresión
  62. gl_widow=.T.        && indicador de comprobar apartados viudos
  63. gn_length=LEN(gc_heading)  && almacena la longitud del encabezamiento (HEADING)
  64. gn_level=2          && apartado actual en proceso
  65. gn_page=_pageno     && captura el número de página actual
  66. gn_pspace=_pspacing && captura el interlineado de la página impresa actual
  67.  
  68.  
  69. *-- Activa el procedimiento para el salto de página
  70. gn_atline=_plength - (_pspacing * 2 + 1)
  71. ON PAGE AT LINE gn_atline EJECT PAGE
  72.  
  73. *-- Imprime el informe
  74.  
  75. PRINTJOB
  76.  
  77. IF gl_plain
  78.    ON PAGE AT LINE gn_atline DO Pgplain
  79. ELSE
  80.    ON PAGE AT LINE gn_atline DO Pgfoot
  81. ENDIF
  82.  
  83. DO Pghead
  84.  
  85. gl_fandl=.T.        && comienzo de la primera página física
  86.  
  87. DO Rintro
  88.  
  89. *-- Bucle de fichero
  90. DO WHILE FOUND() .AND. .NOT. EOF() .AND. gl_prntflg
  91.    gn_level=0
  92.    *-- Cuerpo del informe
  93.    IF gl_summary
  94.       DO Upd_Vars
  95.    ELSE
  96.       DO __Detail
  97.    ENDIF
  98.    gl_widow=.T.         && activa la comprobación de apartados viudos
  99.    CONTINUE
  100. ENDDO
  101.  
  102. IF gl_prntflg
  103.    DO Rsumm
  104.    IF _plineno <= gn_atline
  105.       EJECT PAGE
  106.    ENDIF
  107. ELSE
  108.    DO Rsumm
  109.    DO Reset
  110.    RETURN
  111. ENDIF
  112.  
  113. ON PAGE
  114.  
  115. ENDPRINTJOB
  116.  
  117. DO Reset
  118. RETURN
  119. * EOP: C:\DBASE20\EJEMPLOS\PREFIJOS.FRG
  120.  
  121. *-- Actualiza los campos resumen y/o los campos calculados.
  122. PROCEDURE Upd_Vars
  123. RETURN
  124. * EOP: Upd_Vars
  125.  
  126. *-- Desactiva el indicador para salir del bucle DO WHILE cuando se pulse ESC
  127. PROCEDURE Prnabort
  128. gl_prntflg=.F.
  129. RETURN
  130. * EOP: Prnabort
  131.  
  132. PROCEDURE Pghead
  133. PRIVATE ll_heading, ln_width
  134. ll_heading = .T.
  135. ln_width = _rmargin - _lmargin
  136. ?
  137. *-- Parámetros para imprimir la cabecera - si no cabe en una línea
  138. *-- El valor añadido a gn_length es la última columna de la primera línea dos veces
  139. IF .NOT. gl_plain .AND. gn_length + 156 > ln_width
  140.    ?? gc_heading FUNCTION "I;V"+LTRIM(STR(ln_width))
  141.    ?
  142.    ll_heading = .F.
  143. ENDIF
  144.  
  145. ?? IIF(gl_plain,'',gd_date) AT 0,;
  146.  "PAGINA " AT 67,;
  147.  IIF(gl_plain,'',_pageno) PICTURE "999" 
  148.  
  149. *-- Parámetros para imprimir la cabecera - si cabe en la primera línea
  150. IF .NOT. gl_plain .AND. gn_length > 0 .AND. ll_heading
  151.    ?? " "
  152.    ?? gc_heading FUNCTION "I;V"+LTRIM(STR(ln_width-(_pcolno*2)))
  153. ENDIF
  154. ?
  155. ?
  156. ?
  157. RETURN
  158. * EOP: Pghead
  159.  
  160. PROCEDURE Rintro
  161. ?
  162. DEFINE BOX FROM 25 TO 55 HEIGHT 4 DOUBLE
  163. ?
  164. ?? "A-T INDUSTRIAS DEL MUEBLE" AT 28
  165. ?
  166. ?? "INFORME DE PREFIJOS" AT 31
  167. ?
  168. ?
  169. ?
  170. ?? ;
  171. "══════════════════════════════════════════════════════════════════════";
  172. + "═══════";
  173. AT 0
  174. ?
  175. ?? "CIUDAD" AT 0,;
  176.  "PREFIJO" AT 37
  177. ?
  178. ?? ;
  179. "══════════════════════════════════════════════════════════════════════";
  180. + "═══════";
  181. AT 0
  182. ?
  183. ?
  184. RETURN
  185. * EOP: Rintro
  186.  
  187. PROCEDURE __Detail
  188. IF 2 * gn_pspace < gn_atline - (_pspacing * 4 + 1)
  189.    IF gl_widow .AND. _plineno+2 * gn_pspace > gn_atline + 1
  190.       EJECT PAGE
  191.    ENDIF
  192. ENDIF
  193. DO Upd_Vars
  194. ?? Ciudad FUNCTION "T" AT 0,;
  195.  Prefijo PICTURE "999" AT 37
  196. ?
  197. ?
  198. RETURN
  199. * EOP: __Detail
  200.  
  201. PROCEDURE Rsumm
  202. gl_fandl=.F.        && terminada la última página
  203. ?
  204. RETURN
  205. * EOP: Rsumm
  206.  
  207. PROCEDURE Pgfoot
  208. PRIVATE _box, _pspacing
  209. gl_widow=.F.         && desactiva la comprobación de líneas viudas
  210. _pspacing=1
  211. ?
  212. IF .NOT. gl_plain
  213.    _pspacing=gn_pspace
  214.    ?
  215.    ?? "PREPARADO POR EL DEPARTAMENTO DE RECURSOS HUMANOS" AT 17
  216. ENDIF
  217. EJECT PAGE
  218. *-- comprueba si el número de página es mayor que el de la última página
  219. IF _pageno > _pepage
  220.    GOTO BOTTOM
  221.    SKIP
  222.    gn_level=0
  223. ENDIF
  224. IF .NOT. gl_plain .AND. gl_fandl
  225.    _pspacing=gn_pspace
  226.    DO Pghead
  227. ENDIF
  228. RETURN
  229. * EOP: Pgfoot
  230.  
  231. *-- Proceso de los saltos de página cuando se usa la opción PLAIN
  232. PROCEDURE Pgplain
  233. PRIVATE _box
  234. EJECT PAGE
  235. RETURN
  236. * EOP: Pgplain
  237.  
  238. *-- Restaura el entorno de dBASE previo a la impresión del informe
  239. PROCEDURE Reset
  240. SET SPACE &gc_space.
  241. SET TALK &gc_talk.
  242. ON ESCAPE
  243. ON PAGE
  244. RETURN
  245. * EOP: Reset
  246.  
  247.